Les maladies cardiovasculaires représentent la première cause de mortalité dans le monde, avec plus de 17,9 millions de décès annuels selon l’OMS. Ce projet vise à développer un système de prédiction basé sur des données cliniques pour identifier les patients à risque et permettre une intervention précoce.
Source des données : Heart Disease Dataset - Kaggle
Ce dataset provient de plusieurs institutions médicales et contient 303 observations avec 14 attributs cliniques incluant l’âge, le sexe, le type de douleur thoracique, la pression artérielle, le cholestérol et d’autres indicateurs cardiovasculaires.
Cette analyse suit une approche scientifique rigoureuse en 5 étapes :
Cette section installe et charge tous les packages nécessaires pour l’analyse. Nous utilisons le tidyverse pour la manipulation de données, caret pour le machine learning, et plotly pour des visualisations interactives professionnelles.
# Installation et chargement des packages requis
required_packages <- c(
"tidyverse", # Manipulation & visualisation
"caret", # Machine Learning
"skimr", # Exploration des données
"corrplot", # Corrélations
"randomForest", # Modèle Random Forest
"e1071", # Support pour caret
"pROC", # Courbes ROC / AUC
"ROCR", # Visualisation des performances
"plotly", # Graphiques interactifs
"broom", # Résultats de modèles en dataframes
"janitor", # Nettoyage de données
"knitr", # Tableaux formatés
"kableExtra", # Amélioration des tableaux
"iml", # Interprétabilité des modèles
"reshape2" # Manipulation de données pour heatmaps
)
# Installation des packages manquants
new_packages <- required_packages[!(required_packages %in% installed.packages()[,"Package"])]
if(length(new_packages)) install.packages(new_packages, repos = "http://cran.r-project.org")
# Chargement silencieux
invisible(lapply(required_packages, library, character.only = TRUE))# Configuration du thème graphique personnalisé
theme_set(theme_minimal(base_size = 12))
palette_custom <- c("#3498db", "#e74c3c")Cette section gère l’import, le nettoyage et la transformation des données brutes. Nous effectuons un contrôle qualité rigoureux incluant la détection de doublons, la gestion des valeurs aberrantes et la transformation appropriée des variables catégorielles.
# Chargement du dataset
df_raw <- read_csv("heart.csv", show_col_types = FALSE)
# Aperçu des données brutes
glimpse(df_raw)## Rows: 1,025
## Columns: 14
## $ age <dbl> 52, 53, 70, 61, 62, 58, 58, 55, 46, 54, 71, 43, 34, 51, 52, 3…
## $ sex <dbl> 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1…
## $ cp <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 2, 0, 1, 2, 2…
## $ trestbps <dbl> 125, 140, 145, 148, 138, 100, 114, 160, 120, 122, 112, 132, 1…
## $ chol <dbl> 212, 203, 174, 203, 294, 248, 318, 289, 249, 286, 149, 341, 2…
## $ fbs <dbl> 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0…
## $ restecg <dbl> 1, 0, 1, 1, 1, 0, 2, 0, 0, 0, 1, 0, 1, 1, 1, 1, 0, 0, 1, 0, 0…
## $ thalach <dbl> 168, 155, 125, 161, 106, 122, 140, 145, 144, 116, 125, 136, 1…
## $ exang <dbl> 0, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0, 0…
## $ oldpeak <dbl> 1.0, 3.1, 2.6, 0.0, 1.9, 1.0, 4.4, 0.8, 0.8, 3.2, 1.6, 3.0, 0…
## $ slope <dbl> 2, 0, 0, 2, 1, 1, 0, 1, 2, 1, 1, 1, 2, 1, 1, 2, 2, 1, 2, 2, 1…
## $ ca <dbl> 2, 0, 0, 1, 3, 0, 3, 1, 0, 2, 0, 0, 0, 3, 0, 0, 1, 1, 0, 0, 0…
## $ thal <dbl> 3, 3, 3, 3, 2, 2, 1, 3, 3, 2, 2, 3, 2, 3, 0, 2, 2, 3, 2, 2, 2…
## $ target <dbl> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0…# Pipeline de nettoyage
heart_clean <- df_raw %>%
# Nettoyage des noms de colonnes
clean_names() %>%
# Suppression des doublons stricts
distinct() %>%
# Transformation des variables catégorielles
mutate(
sex = factor(sex, levels = c(0, 1), labels = c("Femme", "Homme")),
cp = factor(cp, levels = 0:3, labels = c("Type 0", "Type 1", "Type 2", "Type 3")),
fbs = factor(fbs, levels = c(0, 1), labels = c("Normal", "Élevé")),
restecg = factor(restecg, levels = 0:2, labels = c("Normal", "Anomalie ST-T", "Hypertrophie")),
exang = factor(exang, levels = c(0, 1), labels = c("Non", "Oui")),
slope = factor(slope, levels = 0:2, labels = c("Ascendant", "Plat", "Descendant")),
ca = factor(ca, levels = 0:4),
thal = factor(thal, levels = 0:3, labels = c("Normal", "Défaut fixe", "Défaut réversible", "Non testé")),
target = factor(ifelse(target == 1, "Malade", "Sain"),
levels = c("Sain", "Malade"))
)
# Rapport de nettoyage
cat(sprintf("
╔═══════════════════════════════════════════════════╗
║ RAPPORT DE NETTOYAGE ║
╠═══════════════════════════════════════════════════╣
║ Observations originales : %5d ║
║ Doublons supprimés : %5d ║
║ Observations finales : %5d ║
║ Variables : %5d ║
╚═══════════════════════════════════════════════════╝
", nrow(df_raw), nrow(df_raw) - nrow(heart_clean),
nrow(heart_clean), ncol(heart_clean)))##
## ╔═══════════════════════════════════════════════════╗
## ║ RAPPORT DE NETTOYAGE ║
## ╠═══════════════════════════════════════════════════╣
## ║ Observations originales : 1025 ║
## ║ Doublons supprimés : 723 ║
## ║ Observations finales : 302 ║
## ║ Variables : 14 ║
## ╚═══════════════════════════════════════════════════╝# Résumé statistique
skim(heart_clean) %>%
select(-skim_type) %>%
kable(caption = "Statistiques Descriptives Complètes du Dataset") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
font_size = 12)| skim_variable | n_missing | complete_rate | factor.ordered | factor.n_unique | factor.top_counts | numeric.mean | numeric.sd | numeric.p0 | numeric.p25 | numeric.p50 | numeric.p75 | numeric.p100 | numeric.hist |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| sex | 0 | 1 | FALSE | 2 | Hom: 206, Fem: 96 | NA | NA | NA | NA | NA | NA | NA | NA |
| cp | 0 | 1 | FALSE | 4 | Typ: 143, Typ: 86, Typ: 50, Typ: 23 | NA | NA | NA | NA | NA | NA | NA | NA |
| fbs | 0 | 1 | FALSE | 2 | Nor: 257, Éle: 45 | NA | NA | NA | NA | NA | NA | NA | NA |
| restecg | 0 | 1 | FALSE | 3 | Ano: 151, Nor: 147, Hyp: 4 | NA | NA | NA | NA | NA | NA | NA | NA |
| exang | 0 | 1 | FALSE | 2 | Non: 203, Oui: 99 | NA | NA | NA | NA | NA | NA | NA | NA |
| slope | 0 | 1 | FALSE | 3 | Des: 141, Pla: 140, Asc: 21 | NA | NA | NA | NA | NA | NA | NA | NA |
| ca | 0 | 1 | FALSE | 5 | 0: 175, 1: 65, 2: 38, 3: 20 | NA | NA | NA | NA | NA | NA | NA | NA |
| thal | 0 | 1 | FALSE | 4 | Déf: 165, Non: 117, Déf: 18, Nor: 2 | NA | NA | NA | NA | NA | NA | NA | NA |
| target | 0 | 1 | FALSE | 2 | Mal: 164, Sai: 138 | NA | NA | NA | NA | NA | NA | NA | NA |
| age | 0 | 1 | NA | NA | NA | 54.420530 | 9.047970 | 29 | 48.00 | 55.5 | 61.00 | 77.0 | ▁▆▇▇▁ |
| trestbps | 0 | 1 | NA | NA | NA | 131.602649 | 17.563394 | 94 | 120.00 | 130.0 | 140.00 | 200.0 | ▃▇▅▁▁ |
| chol | 0 | 1 | NA | NA | NA | 246.500000 | 51.753489 | 126 | 211.00 | 240.5 | 274.75 | 564.0 | ▃▇▂▁▁ |
| thalach | 0 | 1 | NA | NA | NA | 149.569536 | 22.903527 | 71 | 133.25 | 152.5 | 166.00 | 202.0 | ▁▂▅▇▂ |
| oldpeak | 0 | 1 | NA | NA | NA | 1.043046 | 1.161452 | 0 | 0.00 | 0.8 | 1.60 | 6.2 | ▇▂▁▁▁ |
Cette section présente une analyse visuelle approfondie des données pour identifier les patterns, relations et facteurs de risque. Toutes les visualisations sont interactives et conçues pour une exploration intuitive des données cliniques.
# Chargement des données nettoyées
heart_data <- readRDS("heart_ready.rds")
# Palette de couleurs professionnelle
colors_target <- c("#3498db", "#e74c3c")
names(colors_target) <- c("Sain", "Malade")target_summary <- heart_data %>%
count(target) %>%
mutate(percentage = round(n/sum(n)*100, 1))
plot_ly(target_summary,
x = ~target,
y = ~n,
type = "bar",
text = ~paste0(n, " patients<br>", percentage, "%"),
textposition = "outside",
marker = list(color = colors_target,
line = list(color = "white", width = 2))) %>%
layout(
title = list(text = "<b>Répartition des Diagnostics dans la Population Étudiée</b>",
font = list(size = 16)),
xaxis = list(title = "Diagnostic"),
yaxis = list(title = "Nombre de patients"),
plot_bgcolor = "#f8f9fa",
paper_bgcolor = "#ffffff"
)plot_ly(heart_data,
x = ~target,
y = ~age,
color = ~target,
colors = colors_target,
type = "box",
boxmean = "sd") %>%
layout(
title = list(text = "<b>Distribution de l'Âge selon le Diagnostic</b>",
font = list(size = 16)),
xaxis = list(title = "Diagnostic"),
yaxis = list(title = "Âge (années)"),
showlegend = FALSE
)sex_data <- heart_data %>%
group_by(sex, target) %>%
summarise(count = n(), .groups = "drop") %>%
group_by(sex) %>%
mutate(percentage = round(count/sum(count)*100, 1))
plot_ly(sex_data,
x = ~sex,
y = ~percentage,
color = ~target,
colors = colors_target,
type = "bar",
text = ~paste0(percentage, "%"),
textposition = "inside") %>%
layout(
barmode = "stack",
title = list(text = "<b>Proportion de Diagnostics par Sexe</b>",
font = list(size = 16)),
xaxis = list(title = "Sexe"),
yaxis = list(title = "Pourcentage (%)")
)cp_data <- heart_data %>%
group_by(cp, target) %>%
summarise(count = n(), .groups = "drop")
plot_ly(cp_data,
x = ~cp,
y = ~count,
color = ~target,
colors = colors_target,
type = "bar",
text = ~count,
textposition = "outside") %>%
layout(
barmode = "group",
title = list(text = "<b>Type de Douleur Thoracique et Diagnostic</b>",
font = list(size = 16)),
xaxis = list(title = "Type de douleur thoracique (CP)"),
yaxis = list(title = "Nombre de patients")
)plot_ly(heart_data,
x = ~chol,
y = ~trestbps,
color = ~target,
colors = colors_target,
type = "scatter",
mode = "markers",
marker = list(size = 8, opacity = 0.6,
line = list(color = "white", width = 1)),
text = ~paste0("Âge: ", age, " ans<br>",
"Cholestérol: ", chol, " mg/dl<br>",
"Pression: ", trestbps, " mm Hg")) %>%
layout(
title = list(text = "<b>Cholestérol vs Pression Artérielle</b>",
font = list(size = 16)),
xaxis = list(title = "Cholestérol (mg/dl)"),
yaxis = list(title = "Pression artérielle au repos (mm Hg)")
)plot_ly(heart_data,
x = ~thalach,
color = ~target,
colors = colors_target,
type = "histogram",
opacity = 0.7,
nbinsx = 30) %>%
layout(
barmode = "overlay",
title = list(text = "<b>Distribution de la Fréquence Cardiaque Maximale</b>",
font = list(size = 16)),
xaxis = list(title = "Fréquence cardiaque maximale (bpm)"),
yaxis = list(title = "Fréquence")
)cor_data <- heart_data %>%
select_if(is.numeric) %>%
cor(use = "complete.obs")
plot_ly(z = cor_data,
x = colnames(cor_data),
y = rownames(cor_data),
type = "heatmap",
colors = colorRamp(c("#3498db", "#ffffff", "#e74c3c")),
text = round(cor_data, 2),
hovertemplate = "Corrélation entre %{x} et %{y}<br>Valeur: %{z:.2f}<extra></extra>") %>%
layout(
title = list(text = "<b>Matrice de Corrélation des Variables Numériques</b>",
font = list(size = 16)),
xaxis = list(title = ""),
yaxis = list(title = "")
)Cette section présente le développement et l’évaluation de deux approches de machine learning : la régression logistique (modèle interprétable) et le Random Forest (modèle haute performance). Chaque modèle est entraîné avec validation croisée pour assurer la robustesse des résultats.
# Chargement des données
heart_data <- readRDS("heart_ready.rds")
# Séparation train/test stratifiée (80/20)
set.seed(123)
split_index <- createDataPartition(heart_data$target, p = 0.80, list = FALSE)
train_data <- heart_data[split_index, ]
test_data <- heart_data[-split_index, ]
# Prétraitement (normalisation)
preproc_rules <- preProcess(train_data, method = c("center", "scale"))
saveRDS(preproc_rules, "preproc_rules.rds")
# Transformation des données
train_transformed <- predict(preproc_rules, train_data)
# Résumé de la séparation
cat(sprintf("
Données d'entraînement : %d observations (%.1f%%)
Données de test : %d observations (%.1f%%)
", nrow(train_data), nrow(train_data)/nrow(heart_data)*100,
nrow(test_data), nrow(test_data)/nrow(heart_data)*100))##
## Données d'entraînement : 243 observations (80.5%)
## Données de test : 59 observations (19.5%)# Configuration du contrôle d'entraînement
train_control <- trainControl(
method = "cv", # Validation croisée
number = 10, # 10 folds
savePredictions = TRUE,
classProbs = TRUE
)
# Entraînement
model_logistic <- train(
target ~ .,
data = train_data,
method = "glm",
family = "binomial",
metric = "Accuracy",
trControl = train_control
)
# Résumé du modèle
summary(model_logistic$finalModel)##
## Call:
## NULL
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.476826 4.304085 -0.111 0.911787
## age 0.031914 0.030217 1.056 0.290901
## sexHomme -2.540422 0.733923 -3.461 0.000537 ***
## `cpType 1` 1.135942 0.666290 1.705 0.088217 .
## `cpType 2` 2.580086 0.649003 3.975 7.02e-05 ***
## `cpType 3` 3.108531 0.929005 3.346 0.000820 ***
## trestbps -0.031163 0.014376 -2.168 0.030182 *
## chol -0.006395 0.004945 -1.293 0.195963
## fbsÉlevé 1.164452 0.782181 1.489 0.136560
## `restecgAnomalie ST-T` 0.542220 0.480183 1.129 0.258816
## restecgHypertrophie -0.887956 3.165726 -0.280 0.779101
## thalach 0.034625 0.016439 2.106 0.035180 *
## exangOui -1.080917 0.581494 -1.859 0.063047 .
## oldpeak -0.437612 0.293755 -1.490 0.136299
## slopePlat -1.380230 1.241491 -1.112 0.266245
## slopeDescendant 0.035008 1.323315 0.026 0.978894
## ca1 -2.477551 0.653870 -3.789 0.000151 ***
## ca2 -4.426415 1.035257 -4.276 1.91e-05 ***
## ca3 -1.951556 1.069810 -1.824 0.068121 .
## ca4 1.374177 1.830545 0.751 0.452837
## `thalDéfaut fixe` 3.760582 2.869703 1.310 0.190046
## `thalDéfaut réversible` 2.612502 2.695061 0.969 0.332362
## `thalNon testé` 1.176534 2.692850 0.437 0.662176
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 335.05 on 242 degrees of freedom
## Residual deviance: 127.98 on 220 degrees of freedom
## AIC: 173.98
##
## Number of Fisher Scoring iterations: 7# Prédictions
pred_log_class <- predict(model_logistic, test_data)
pred_log_prob <- predict(model_logistic, test_data, type = "prob")
# Matrice de confusion
cm_log <- confusionMatrix(pred_log_class, test_data$target, positive = "Malade")
print(cm_log)## Confusion Matrix and Statistics
##
## Reference
## Prediction Sain Malade
## Sain 20 4
## Malade 7 28
##
## Accuracy : 0.8136
## 95% CI : (0.6909, 0.9031)
## No Information Rate : 0.5424
## P-Value [Acc > NIR] : 1.224e-05
##
## Kappa : 0.6211
##
## Mcnemar's Test P-Value : 0.5465
##
## Sensitivity : 0.8750
## Specificity : 0.7407
## Pos Pred Value : 0.8000
## Neg Pred Value : 0.8333
## Prevalence : 0.5424
## Detection Rate : 0.4746
## Detection Prevalence : 0.5932
## Balanced Accuracy : 0.8079
##
## 'Positive' Class : Malade
## # Courbe ROC
roc_log <- roc(test_data$target, pred_log_prob$Malade)
auc_log <- auc(roc_log)
# Création du dataframe pour plotly
roc_log_df <- data.frame(
FPR = 1 - roc_log$specificities,
TPR = roc_log$sensitivities
)
plot_ly(roc_log_df, x = ~FPR, y = ~TPR, type = 'scatter', mode = 'lines',
line = list(color = '#3498db', width = 3),
name = 'ROC Curve',
hovertemplate = 'FPR: %{x:.3f}<br>TPR: %{y:.3f}<extra></extra>') %>%
add_trace(x = c(0, 1), y = c(0, 1), type = 'scatter', mode = 'lines',
line = list(color = 'gray', dash = 'dash', width = 2),
name = 'Ligne de base',
hoverinfo = 'skip') %>%
layout(
title = list(text = sprintf("<b>Courbe ROC - Régression Logistique (AUC = %.3f)</b>", auc_log),
font = list(size = 16)),
xaxis = list(title = "Taux de Faux Positifs (1 - Spécificité)", range = c(0, 1)),
yaxis = list(title = "Taux de Vrais Positifs (Sensibilité)", range = c(0, 1)),
showlegend = TRUE,
hovermode = 'closest'
)# Extraction des Odds Ratios
facteurs_influence <- tidy(model_logistic$finalModel,
exponentiate = TRUE,
conf.int = TRUE) %>%
filter(term != "(Intercept)") %>%
arrange(desc(estimate))
# Visualisation avec plotly
plot_ly(facteurs_influence,
y = ~reorder(term, estimate),
x = ~estimate,
type = 'scatter',
mode = 'markers',
marker = list(size = 12, color = '#e74c3c'),
error_x = list(
type = 'data',
symmetric = FALSE,
array = ~(conf.high - estimate),
arrayminus = ~(estimate - conf.low),
color = '#e74c3c',
thickness = 2
),
hovertemplate = paste0(
'<b>%{y}</b><br>',
'Odds Ratio: %{x:.3f}<br>',
'IC 95%: [%{error_x.arrayminus:.3f}, %{error_x.array:.3f}]',
'<extra></extra>'
)) %>%
layout(
title = list(text = "<b>Impact des Facteurs sur le Risque Cardiaque</b>",
font = list(size = 16)),
xaxis = list(title = "Odds Ratio (échelle logarithmique)", type = "log"),
yaxis = list(title = "Variables cliniques"),
shapes = list(
list(type = "line", x0 = 1, x1 = 1, y0 = -0.5, y1 = nrow(facteurs_influence) - 0.5,
line = list(color = "#3498db", dash = "dash", width = 2))
)
)# Tableau des OR significatifs
facteurs_influence %>%
filter(p.value < 0.05) %>%
select(term, estimate, conf.low, conf.high, p.value) %>%
mutate(across(where(is.numeric), ~round(., 3))) %>%
kable(caption = "Odds Ratios Significatifs (p < 0.05)",
col.names = c("Variable", "Odds Ratio", "IC 95% Inf", "IC 95% Sup", "p-value")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE)| Variable | Odds Ratio | IC 95% Inf | IC 95% Sup | p-value |
|---|---|---|---|---|
cpType 3
|
22.388 | 4.012 | 159.355 | 0.001 |
cpType 2
|
13.198 | 3.938 | 51.371 | 0.000 |
| thalach | 1.035 | 1.004 | 1.072 | 0.035 |
| trestbps | 0.969 | 0.941 | 0.996 | 0.030 |
| ca1 | 0.084 | 0.021 | 0.286 | 0.000 |
| sexHomme | 0.079 | 0.017 | 0.307 | 0.001 |
| ca2 | 0.012 | 0.001 | 0.081 | 0.000 |
# Entraînement Random Forest
set.seed(123)
model_rf <- train(
target ~ .,
data = train_data,
method = "rf",
ntree = 100,
importance = TRUE,
metric = "Accuracy",
trControl = trainControl(method = "cv", number = 5, classProbs = TRUE)
)
print(model_rf)## Random Forest
##
## 243 samples
## 13 predictor
## 2 classes: 'Sain', 'Malade'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 195, 195, 193, 195, 194
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa
## 2 0.8274252 0.6526568
## 12 0.7905136 0.5774063
## 22 0.8030136 0.6026668
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.# Importance des variables
importance_rf <- varImp(model_rf)
# Extraction et formatage des données d'importance
importance_data <- importance_rf$importance %>%
as.data.frame() %>%
tibble::rownames_to_column("Variable") %>%
rename(Importance = Malade) %>% # La colonne s'appelle "Malade" dans votre cas
arrange(desc(Importance))
plot_ly(importance_data,
x = ~Importance,
y = ~reorder(Variable, Importance),
type = 'bar',
orientation = 'h',
marker = list(color = '#f1c40f',
line = list(color = 'white', width = 1)),
hovertemplate = '<b>%{y}</b><br>Importance: %{x:.2f}<extra></extra>') %>%
layout(
title = list(text = "<b>Importance des Variables - Random Forest</b>",
font = list(size = 16)),
xaxis = list(title = "Importance Relative"),
yaxis = list(title = "")
)# Prédictions
pred_rf_class <- predict(model_rf, test_data)
pred_rf_prob <- predict(model_rf, test_data, type = "prob")
# Matrice de confusion
cm_rf <- confusionMatrix(pred_rf_class, test_data$target, positive = "Malade")
print(cm_rf)## Confusion Matrix and Statistics
##
## Reference
## Prediction Sain Malade
## Sain 22 6
## Malade 5 26
##
## Accuracy : 0.8136
## 95% CI : (0.6909, 0.9031)
## No Information Rate : 0.5424
## P-Value [Acc > NIR] : 1.224e-05
##
## Kappa : 0.6255
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.8125
## Specificity : 0.8148
## Pos Pred Value : 0.8387
## Neg Pred Value : 0.7857
## Prevalence : 0.5424
## Detection Rate : 0.4407
## Detection Prevalence : 0.5254
## Balanced Accuracy : 0.8137
##
## 'Positive' Class : Malade
## # Courbe ROC
roc_rf <- roc(test_data$target, pred_rf_prob$Malade)
auc_rf <- auc(roc_rf)
# Création du dataframe pour plotly
roc_rf_df <- data.frame(
FPR = 1 - roc_rf$specificities,
TPR = roc_rf$sensitivities
)
plot_ly(roc_rf_df, x = ~FPR, y = ~TPR, type = 'scatter', mode = 'lines',
line = list(color = '#f1c40f', width = 3),
name = 'ROC Curve',
hovertemplate = 'FPR: %{x:.3f}<br>TPR: %{y:.3f}<extra></extra>') %>%
add_trace(x = c(0, 1), y = c(0, 1), type = 'scatter', mode = 'lines',
line = list(color = 'gray', dash = 'dash', width = 2),
name = 'Ligne de base',
hoverinfo = 'skip') %>%
layout(
title = list(text = sprintf("<b>Courbe ROC - Random Forest (AUC = %.3f)</b>", auc_rf),
font = list(size = 16)),
xaxis = list(title = "Taux de Faux Positifs (1 - Spécificité)", range = c(0, 1)),
yaxis = list(title = "Taux de Vrais Positifs (Sensibilité)", range = c(0, 1)),
showlegend = TRUE,
hovermode = 'closest'
)Cette section présente une comparaison rigoureuse et quantitative des deux approches de modélisation. Les métriques de performance sont stockées dans des structures de données professionnelles pour faciliter l’analyse et la prise de décision.
# Création du tableau de comparaison structuré
df_performance <- data.frame(
Métrique = c("Précision (Accuracy)", "Sensibilité (Recall)", "Spécificité", "AUC-ROC"),
Régression_Logistique = c(
cm_log$overall["Accuracy"],
cm_log$byClass["Sensitivity"],
cm_log$byClass["Specificity"],
auc_log
),
Random_Forest = c(
cm_rf$overall["Accuracy"],
cm_rf$byClass["Sensitivity"],
cm_rf$byClass["Specificity"],
auc_rf
)
)
# Calcul de la différence de performance
df_performance$Différence <- df_performance$Random_Forest - df_performance$Régression_Logistique
# Formatage et affichage
df_performance %>%
mutate(across(where(is.numeric), ~round(., 4))) %>%
kable(caption = "Tableau Comparatif des Performances des Modèles",
col.names = c("Métrique", "Régression Logistique", "Random Forest", "Δ (RF - RL)"),
align = c("l", "c", "c", "c")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
font_size = 13) %>%
column_spec(1, bold = TRUE, width = "10em") %>%
column_spec(2:4, width = "8em") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Métrique | Régression Logistique | Random Forest | Δ (RF - RL) | |
|---|---|---|---|---|
| Accuracy | Précision (Accuracy) | 0.8136 | 0.8136 | 0.0000 |
| Sensitivity | Sensibilité (Recall) | 0.8750 | 0.8125 | -0.0625 |
| Specificity | Spécificité | 0.7407 | 0.8148 | 0.0741 |
| AUC-ROC | 0.8981 | 0.9034 | 0.0052 |
# Sauvegarde du tableau de performance pour utilisation future
saveRDS(df_performance, "performance_comparison.rds")
# Résumé structuré
performance_summary <- list(
logistic_regression = list(
accuracy = cm_log$overall["Accuracy"],
sensitivity = cm_log$byClass["Sensitivity"],
specificity = cm_log$byClass["Specificity"],
auc = auc_log,
confusion_matrix = cm_log$table
),
random_forest = list(
accuracy = cm_rf$overall["Accuracy"],
sensitivity = cm_rf$byClass["Sensitivity"],
specificity = cm_rf$byClass["Specificity"],
auc = auc_rf,
confusion_matrix = cm_rf$table
),
comparison = df_performance
)
saveRDS(performance_summary, "performance_summary.rds")df_plot <- df_performance %>%
select(-Différence) %>%
pivot_longer(cols = -Métrique, names_to = "Modèle", values_to = "Valeur") %>%
mutate(Modèle = ifelse(Modèle == "Régression_Logistique", "Régression Logistique", "Random Forest"))
plot_ly(df_plot,
x = ~Métrique,
y = ~Valeur,
color = ~Modèle,
type = "bar",
colors = c("#3498db", "#f1c40f"),
text = ~round(Valeur, 3),
textposition = "outside",
hovertemplate = '<b>%{x}</b><br>%{data.name}: %{y:.4f}<extra></extra>') %>%
layout(
title = list(text = "<b>Comparaison des Performances : Régression Logistique vs Random Forest</b>",
font = list(size = 16)),
yaxis = list(title = "Score", range = c(0, 1.1)),
xaxis = list(title = ""),
barmode = 'group',
hovermode = "x unified",
legend = list(orientation = "h", x = 0.3, y = -0.15)
)# Création des dataframes pour les deux modèles
roc_comparison_df <- rbind(
data.frame(
FPR = 1 - roc_log$specificities,
TPR = roc_log$sensitivities,
Modèle = "Régression Logistique"
),
data.frame(
FPR = 1 - roc_rf$specificities,
TPR = roc_rf$sensitivities,
Modèle = "Random Forest"
)
)
plot_ly() %>%
add_trace(data = filter(roc_comparison_df, Modèle == "Régression Logistique"),
x = ~FPR, y = ~TPR, type = 'scatter', mode = 'lines',
name = sprintf('Régression Logistique (AUC = %.3f)', auc_log),
line = list(color = '#3498db', width = 3),
hovertemplate = 'FPR: %{x:.3f}<br>TPR: %{y:.3f}<extra></extra>') %>%
add_trace(data = filter(roc_comparison_df, Modèle == "Random Forest"),
x = ~FPR, y = ~TPR, type = 'scatter', mode = 'lines',
name = sprintf('Random Forest (AUC = %.3f)', auc_rf),
line = list(color = '#f1c40f', width = 3),
hovertemplate = 'FPR: %{x:.3f}<br>TPR: %{y:.3f}<extra></extra>') %>%
add_trace(x = c(0, 1), y = c(0, 1), type = 'scatter', mode = 'lines',
name = 'Ligne de base (AUC = 0.500)',
line = list(color = 'gray', dash = 'dash', width = 2),
hoverinfo = 'skip') %>%
layout(
title = list(text = "<b>Comparaison des Courbes ROC</b>",
font = list(size = 16)),
xaxis = list(title = "Taux de Faux Positifs (1 - Spécificité)", range = c(0, 1)),
yaxis = list(title = "Taux de Vrais Positifs (Sensibilité)", range = c(0, 1)),
showlegend = TRUE,
legend = list(x = 0.6, y = 0.2),
hovermode = 'closest'
)Cette section synthétise les résultats de l’analyse comparative et fournit des recommandations pratiques basées sur les performances observées et les contraintes du contexte clinique.
# Chargement du résumé des performances
perf_summary <- readRDS("performance_summary.rds")
cat(sprintf("
╔═══════════════════════════════════════════════════════════════╗
║ RÉSUMÉ DES PERFORMANCES ║
╠═══════════════════════════════════════════════════════════════╣
║ ║
║ RÉGRESSION LOGISTIQUE ║
║ • Précision : %.1f%% ║
║ • Sensibilité : %.1f%% ║
║ • Spécificité : %.1f%% ║
║ • AUC-ROC : %.3f ║
║ • Avantage : Interprétabilité clinique (Odds Ratios) ║
║ ║
║ RANDOM FOREST ║
║ • Précision : %.1f%% ║
║ • Sensibilité : %.1f%% ║
║ • Spécificité : %.1f%% ║
║ • AUC-ROC : %.3f ║
║ • Avantage : Capture des interactions non-linéaires ║
║ ║
║ MEILLEUR MODÈLE : %-45s ║
║ ║
╚═══════════════════════════════════════════════════════════════╝
",
perf_summary$logistic_regression$accuracy * 100,
perf_summary$logistic_regression$sensitivity * 100,
perf_summary$logistic_regression$specificity * 100,
perf_summary$logistic_regression$auc,
perf_summary$random_forest$accuracy * 100,
perf_summary$random_forest$sensitivity * 100,
perf_summary$random_forest$specificity * 100,
perf_summary$random_forest$auc,
ifelse(perf_summary$random_forest$auc > perf_summary$logistic_regression$auc,
"Random Forest (performance)",
"Régression Logistique (performance)")))##
## ╔═══════════════════════════════════════════════════════════════╗
## ║ RÉSUMÉ DES PERFORMANCES ║
## ╠═══════════════════════════════════════════════════════════════╣
## ║ ║
## ║ RÉGRESSION LOGISTIQUE ║
## ║ • Précision : 81.4% ║
## ║ • Sensibilité : 87.5% ║
## ║ • Spécificité : 74.1% ║
## ║ • AUC-ROC : 0.898 ║
## ║ • Avantage : Interprétabilité clinique (Odds Ratios) ║
## ║ ║
## ║ RANDOM FOREST ║
## ║ • Précision : 81.4% ║
## ║ • Sensibilité : 81.2% ║
## ║ • Spécificité : 81.5% ║
## ║ • AUC-ROC : 0.903 ║
## ║ • Avantage : Capture des interactions non-linéaires ║
## ║ ║
## ║ MEILLEUR MODÈLE : Random Forest (performance) ║
## ║ ║
## ╚═══════════════════════════════════════════════════════════════╝# Tableau de recommandations selon le contexte d'utilisation
decision_framework <- data.frame(
Contexte = c(
"Dépistage en cabinet médical",
"Recherche clinique",
"Application mobile grand public",
"Système d'aide à la décision hospitalier",
"Analyse épidémiologique"
),
Modèle_Recommandé = c(
"Régression Logistique",
"Random Forest",
"Random Forest",
"Hybride (les deux)",
"Régression Logistique"
),
Justification = c(
"Interprétabilité pour expliquer au patient",
"Performance maximale pour essais cliniques",
"Précision optimale pour recommandations automatiques",
"Combinaison performance + explicabilité",
"Identification claire des facteurs de risque populationnels"
),
Priorité_Métrique = c(
"Spécificité (éviter faux positifs)",
"AUC-ROC",
"Sensibilité (détecter tous les cas)",
"Équilibre Sensibilité/Spécificité",
"Interprétabilité des coefficients"
)
)
decision_framework %>%
kable(caption = "Guide de Sélection du Modèle selon le Contexte Clinique",
col.names = c("Contexte d'Utilisation", "Modèle Recommandé",
"Justification", "Métrique Prioritaire")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = TRUE,
font_size = 12) %>%
column_spec(1, bold = TRUE, width = "12em") %>%
column_spec(2, width = "10em", background = "#ecf0f1") %>%
column_spec(3, width = "20em") %>%
column_spec(4, width = "12em") %>%
row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")| Contexte d’Utilisation | Modèle Recommandé | Justification | Métrique Prioritaire |
|---|---|---|---|
| Dépistage en cabinet médical | Régression Logistique | Interprétabilité pour expliquer au patient | Spécificité (éviter faux positifs) |
| Recherche clinique | Random Forest | Performance maximale pour essais cliniques | AUC-ROC |
| Application mobile grand public | Random Forest | Précision optimale pour recommandations automatiques | Sensibilité (détecter tous les cas) |
| Système d’aide à la décision hospitalier | Hybride (les deux) | Combinaison performance + explicabilité | Équilibre Sensibilité/Spécificité |
| Analyse épidémiologique | Régression Logistique | Identification claire des facteurs de risque populationnels | Interprétabilité des coefficients |
recommendations <- data.frame(
Catégorie = c(
"Déploiement Immédiat",
"Déploiement Immédiat",
"Amélioration Court Terme",
"Amélioration Court Terme",
"Amélioration Moyen Terme",
"Amélioration Long Terme"
),
Action = c(
"Utiliser Random Forest pour les prédictions automatiques",
"Conserver Régression Logistique pour l'explicabilité médicale",
"Collecter davantage de données (objectif: 1000+ patients)",
"Implémenter un système de monitoring des prédictions",
"Optimisation des hyperparamètres (Grid Search, Bayesian Optimization)",
"Développer un modèle ensemble (stacking RF + RL)"
),
Impact_Attendu = c(
"Haute précision (AUC > 0.85)",
"Confiance des cliniciens",
"Réduction du surapprentissage",
"Détection de la dérive du modèle",
"+2-5% de performance",
"+3-7% de performance"
),
Effort = c("Faible", "Faible", "Moyen", "Moyen", "Élevé", "Élevé")
)
recommendations %>%
kable(caption = "Feuille de Route pour le Déploiement et l'Amélioration Continue") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = TRUE) %>%
column_spec(1, bold = TRUE, width = "10em") %>%
pack_rows("Actions Immédiates", 1, 2, label_row_css = "background-color: #27ae60; color: white;") %>%
pack_rows("Améliorations à Court Terme (1-3 mois)", 3, 4,
label_row_css = "background-color: #f39c12; color: white;") %>%
pack_rows("Améliorations à Moyen-Long Terme (3-12 mois)", 5, 6,
label_row_css = "background-color: #3498db; color: white;")| Catégorie | Action | Impact_Attendu | Effort |
|---|---|---|---|
| Actions Immédiates | |||
| Déploiement Immédiat | Utiliser Random Forest pour les prédictions automatiques | Haute précision (AUC > 0.85) | Faible |
| Déploiement Immédiat | Conserver Régression Logistique pour l’explicabilité médicale | Confiance des cliniciens | Faible |
| Améliorations à Court Terme (1-3 mois) | |||
| Amélioration Court Terme | Collecter davantage de données (objectif: 1000+ patients) | Réduction du surapprentissage | Moyen |
| Amélioration Court Terme | Implémenter un système de monitoring des prédictions | Détection de la dérive du modèle | Moyen |
| Améliorations à Moyen-Long Terme (3-12 mois) | |||
| Amélioration Moyen Terme | Optimisation des hyperparamètres (Grid Search, Bayesian Optimization) | +2-5% de performance | Élevé |
| Amélioration Long Terme | Développer un modèle ensemble (stacking RF + RL) | +3-7% de performance | Élevé |
⚠️ Limitations identifiées :
✅ Forces du modèle :
## R version 4.5.2 (2025-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26200)
##
## Matrix products: default
## LAPACK version 3.12.1
##
## locale:
## [1] LC_COLLATE=French_France.utf8 LC_CTYPE=French_France.utf8
## [3] LC_MONETARY=French_France.utf8 LC_NUMERIC=C
## [5] LC_TIME=French_France.utf8
##
## time zone: Africa/Lome
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] reshape2_1.4.5 iml_0.11.4 kableExtra_1.4.0
## [4] knitr_1.50 janitor_2.2.1 broom_1.0.11
## [7] plotly_4.11.0 ROCR_1.0-11 pROC_1.19.0.1
## [10] e1071_1.7-16 randomForest_4.7-1.2 corrplot_0.95
## [13] skimr_2.2.1 caret_7.0-1 lattice_0.22-7
## [16] lubridate_1.9.4 forcats_1.0.1 stringr_1.6.0
## [19] dplyr_1.1.4 purrr_1.2.0 readr_2.1.6
## [22] tidyr_1.3.1 tibble_3.3.0 ggplot2_4.0.1
## [25] tidyverse_2.0.0
##
## loaded via a namespace (and not attached):
## [1] rlang_1.1.6 magrittr_2.0.4 snakecase_0.11.1
## [4] compiler_4.5.2 systemfonts_1.3.1 vctrs_0.6.5
## [7] crayon_1.5.3 pkgconfig_2.0.3 fastmap_1.2.0
## [10] backports_1.5.0 rmarkdown_2.30 prodlim_2025.04.28
## [13] tzdb_0.5.0 bit_4.6.0 xfun_0.54
## [16] cachem_1.1.0 jsonlite_2.0.0 recipes_1.3.1
## [19] parallel_4.5.2 R6_2.6.1 bslib_0.9.0
## [22] stringi_1.8.7 RColorBrewer_1.1-3 parallelly_1.45.1
## [25] rpart_4.1.24 jquerylib_0.1.4 Rcpp_1.1.0
## [28] iterators_1.0.14 future.apply_1.20.0 base64enc_0.1-3
## [31] Metrics_0.1.4 Matrix_1.7-4 splines_4.5.2
## [34] nnet_7.3-20 timechange_0.3.0 tidyselect_1.2.1
## [37] rstudioapi_0.17.1 yaml_2.3.11 timeDate_4051.111
## [40] codetools_0.2-20 listenv_0.10.0 plyr_1.8.9
## [43] withr_3.0.2 S7_0.2.1 evaluate_1.0.5
## [46] future_1.68.0 survival_3.8-3 proxy_0.4-27
## [49] xml2_1.5.1 pillar_1.11.1 checkmate_2.3.3
## [52] foreach_1.5.2 stats4_4.5.2 generics_0.1.4
## [55] vroom_1.6.7 hms_1.1.4 scales_1.4.0
## [58] globals_0.18.0 class_7.3-23 glue_1.8.0
## [61] lazyeval_0.2.2 tools_4.5.2 data.table_1.17.8
## [64] ModelMetrics_1.2.2.2 gower_1.0.2 grid_4.5.2
## [67] crosstalk_1.2.2 ipred_0.9-15 nlme_3.1-168
## [70] repr_1.1.7 cli_3.6.5 textshaping_1.0.4
## [73] viridisLite_0.4.2 svglite_2.2.2 lava_1.8.2
## [76] gtable_0.3.6 sass_0.4.10 digest_0.6.39
## [79] htmlwidgets_1.6.4 farver_2.1.2 htmltools_0.5.9
## [82] lifecycle_1.0.4 hardhat_1.4.2 httr_1.4.7
## [85] bit64_4.6.0-1 MASS_7.3-65Auteurs :
- FEBON S. Daniel
- BODI - SAMA Souweba
Pour toute question sur la méthodologie, les résultats ou
l’implémentation :
Veuillez utiliser le système de ticketing du projet ou contacter
directement les auteurs.
Note finale : Ce rapport a été généré
automatiquement avec R Markdown. Tous les résultats sont reproductibles
en exécutant le script source avec les données fournies. Les modèles
entraînés sont sauvegardés dans les fichiers .rds pour
utilisation ultérieure dans l’application Shiny ou d’autres
analyses.